SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00039 FILE HANDLING ROUTINES 1 05-28-9313:46ALL SWAG SUPPORT TEAM FILATTR1.PAS IMPORT 11 .l╟√ {> How does one go about changing a File attributeπ> from hidden to unhidden using SetFAttr ?ππTry these two Procedures on For size:π}πGetFAttr(FName:String;Var RdOnly,Hid,Sys,Arch:Boolean);πVar R:Registers;πbeginπ FillChar(R,Sizeof(R),0);π FName := FName+#0; { set up as a null-terminated String For Dos }π With R Do beginπ AH := $43;π DS := Seg(FName); DX := ofs(FName)+1; { skip pascal length Byte }π MsDos(R);π RdOnly := (CL and $01) > 0;π Hid := (CL and $02) > 0;π Sys := (CL and $04) > 0;π Arch := (CL and $20) > 0;π end; { With }πend; { GetFAttr }ππPutFAttr(FName:String;RdOnly,Hid,Sys,Arch:Boolean);πVar R:Registers;πbeginπ FillChar(R,Sizeof(R),0);π FName := FName+#0; { set up as a null-terminated String For Dos }π With R Do beginπ AH := $43; AL := 1;π DS := Seg(FName); DX := ofs(FName)+1; { skip pascal length Byte }π if RdOnly then CL := CL or $01;π if Hid then CL := CL or $02;π if Sys then CL := CL or $04;π if Arch then CL := CL or $20;π MsDos(R);π end; { With }πend; { PutFAttr }ππ{The File FName does not have to be opened For this to work. In fact, itπwould probably be better if it were not.π}π 2 05-28-9313:46ALL SWAG SUPPORT TEAM FILATTR2.PAS IMPORT 6 .l▄┘ {πJOE DICKSONππ> I was wondering if someone could tell me how to change the Time and Dateπ> and maybe the Attribute of a File? Lets say I want to Change:π> FileNAME.EXT 1024 01-24-93 12:33p A to:π> FileNAME.EXT 1024 01-01-93 01:00a ARπ}ππProgram change_sample_Files_attribs;ππUsesπ Dos;ππVarπ f : File;π attr : Word;π time : LongInt;π DT : datetime;ππbeginπ assign(f, 'FileNAME.EXT');π DT.year := 93;π DT.month := 1;π DT.day := 1;π dt.hour := 1;π dt.min := 0;π dt.sec := 0;π packtime(dt, time);π attr := ReadOnly;π setftime(f, time);π setfattr(f, attr);πend.π 3 05-28-9313:46ALL SWAG SUPPORT TEAM FILEMODE.PAS IMPORT 16 .lΣM RB > I use a shared File to transfer info betweenπ > multitasker Windows that are running the same application.π > Lately, I have been getting Runtime errors 2, 5 & 162 in the following spoππTry to set the "FileMode" Constant to 66 (read/Write) orπ64 (read) beFore opening it. Here's a map of valid valuesπto FileMode:ππ ----- Sharing Method -----πAccess Compatibility Deny Deny Deny DenyπMethod Mode Both Write Read Noneπ___------------------------------------------------------πRead Only 0 16 32 48 64πWrite Only 1 17 33 49 65πRead/Write 2* 18 34 50 66ππ * = defaultππFile locking is seldom useful For Real life applications.πSometimes however, File locking MAY be appropriate, such asπwhen a Compiled list is produced at the Printer; if usersπare allowed to update the database then, the list can containπmultiple instances of a Record or reference... :-)ππUse Record locking instead, when required, For most purposesπand add logic to prevent disasters and user misunderstandings.πUsers will generally be more happy if they're not deniedπWrite access all the time... :-)ππRB > Perhaps I need to disable I/O checking and put in some Delays ifπ > this File is being accessed simulataneously. Also, the size of this FileππDefinately disable I/O checking. Don't add Delays if youπcan avoid it. Beware of dead-lock situations which occurπwhen two or more users access the same File With inadequateπaccess rights and they're all put on hold Until the Fileπis released by the other... One way to catch these situationsπis to retry a specified number of times and then cancel theπoperation With an error message perhaps.π 4 05-28-9313:46ALL SWAG SUPPORT TEAM FILENAME.PAS IMPORT 4 .l76 if you want to remove the period, and all Characters after it inπa valid Dos Filename, do the following...ππFileName := 'MYFile.TXT';πName := Copy(FileName, 1, Pos('.', FileName) - 1);ππThat will do it. or you can use FSplit to break out all theπdifferent parts of a Filename/path and get it that way.ππ 5 05-28-9313:46ALL SWAG SUPPORT TEAM FILESTMP.PAS IMPORT 10 .l-╩ { Example For GetFTime, PackTime,π SetFTime, and UnpackTime }ππUses Dos;πVarπ f: Text;π h, m, s, hund : Word; { For GetTime}π ftime : LongInt; { For Get/SetFTime}π dt : DateTime; { For Pack/UnpackTime}πFunction LeadingZero(w : Word) : String;πVarπ s : String;πbeginπ Str(w:0,s);π if Length(s) = 1 thenπ s := '0' + s;π LeadingZero := s;πend;πbeginπ Assign(f, 'RECURSEP.PAS');π GetTime(h,m,s,hund);π ReWrite(f); { Create new File }π GetFTime(f,ftime); { Get creation time }π WriteLn('File created at ',LeadingZero(h),π ':',LeadingZero(m),':',π LeadingZero(s));π UnpackTime(ftime,dt);π With dt doπ beginπ WriteLn('File timestamp is ',π LeadingZero(hour),':',π LeadingZero(min),':',π LeadingZero(sec));π hour := 0;π min := 1;π sec := 0;π PackTime(dt,ftime);π WriteLn('Setting File timestamp ',π 'to one minute after midnight');π Reset(f); { Reopen File For reading }π { (otherwise, close will update time) }π SetFTime(f,ftime);π end;π Close(f); { Close File }πend.π 6 05-28-9313:46ALL SWAG SUPPORT TEAM FILESTR.PAS IMPORT 10 .l╟í {$B-,D-,F-,I-,L-,N-,O-,R-,S-,V-}ππUnit Filestr;ππInterfaceππUses Dos;ππFunction GetFstr(Var f: Text): String;πProcedure OpenFStr(Var f: Text);ππImplementationππVarπ FStrBuff : String;ππFunction GetFStr(Var f: Text): String;π beginπ GetFStr := FStrBuff;π FStrBuff[0] := #0;π TextRec(f).BufPos := 0;π end; { GetFStr }π π{$F+}πFunction FStrOpen(Var f: TextRec):Word;π { This does nothing except return zero to indicate success }π beginπ FStrOpen := 0;π end; { FStrOpen }π πFunction FStrInOut(Var f: TextRec):Word;π beginπ FStrBuff[0] := chr(F.BufPos); π FStrInOut := 0;π end; { FStrInOut } π{$F-}ππProcedure OpenFStr(Var f: Text);π beginπ With TextRec(f) do beginπ mode := fmClosed;π BufSize := Sizeof(buffer);π OpenFunc := @FStrOpen;π InOutFunc := @FStrInOut;π FlushFunc := @FStrInOut;π CloseFunc := @FStrOpen;π BufPos := 0;π Bufend := 0;π BufPtr := @FStrBuff[1];π Name[0] := #0;π end; { With }π FStrBuff[0] := #0;π reWrite(f);π end; { AssignFStr } πππend. π 7 05-28-9313:46ALL SWAG SUPPORT TEAM FILEXIST.PAS IMPORT 6 .l*ä { 1 }ππFunction FileExist(FileName : String) : Boolean;πbeginπ FileExist := (FSearch(FileName, '') <> '')πend; (* FileExist. *)ππ{ 2 }ππFunction FileExist(FileName : String) : Boolean;πVarπ SRec : SearchRec;πbeginπ FindFirst(FileName, AnyFile, SRec);π FileExist := (DosError = 0);πend;ππ{ 3 }ππFunction FileExists(FileName : String) : Boolean;πVarπ DirInfo : SearchRec;πbeginπ FindFirst(FileName, AnyFile, DirInfo);π if (DosError = 0) thenπ FileExists := Trueπ elseπ FileExists := False;πend;ππ 8 05-28-9313:46ALL SWAG SUPPORT TEAM FILSHAR1.PAS IMPORT 6 .lµΘ Program ShareVolation;πUses Dos,Crt;πVarπ Dummy: Boolean;ππFunction FileOpen(F:String):Boolean;πVarπ Regs: Registers;π I: Byte;πbeginπ With Regs doπ beginπ Ah := $3d;π Al := 2;π Ds := Seg(F);π Dx := Ofs(F)+1;π end;π Intr($21,Regs);ππ WriteLn(F,' open: ',Regs.Ax = 5);π FileOpen := (Regs.Ax = 5);πend; { FileOpen }ππbeginπ Dummy := FileOpen('D:\FILSHARE.EXE'+#0);π Dummy := FileOpen('C:\CONFIG.SYS'+#0);π Dummy := FileOpen('C:\IO.SYS'+#0);π Dummy := FileOpen('C:\MSDos.SYS'+#0);πend.ππ{πAnd the funny thing was that it worked..π(But it returns error code 6 [Invalide handle] on closed Files)..π} 9 05-28-9313:46ALL SWAG SUPPORT TEAM FILSHAR2.PAS IMPORT 7 .lΘr Program ShareVolation;πUses Dos,Crt;ππFunction FileOpen(S:String):Boolean; Assembler;π{ -returns True if File already is open (Access denied) ..}πAsmπ PUSH DS { changes are in all caps }π mov ah,03dhπ xor al,alπ LDS DX, Sπ INC DX { point to contents of String }π int 21hπ mov bx,axπ mov al,0 { FileOpen = False }π jnc @endπ cmp bx,05h { Access denied}π jz @Openπ jmp @endππ@Open:π mov al,1 { FileOpen = True}π@end:π POP DSπend; { FileOpen }πππVarπ F : Text ;ππbeginπ FileMode := $10 ; { deny read/Write ?? }π Assign( F, 'C:\TEST.TXT' ) ;π ReWrite( F ) ;ππ WriteLn(FileOpen('C:\TEST.TXT'+ #0)); { SHARE is loaded }π Close( F ) ;πend.π 10 05-28-9313:46ALL SWAG SUPPORT TEAM FILSHAR3.PAS IMPORT 18 .l)╜ FileSHARinG !πππWhen sharing Files concurrently, by means of For example a multitasker or aπnetwork, it is necessary to use the File sharing as provided by the Dosπcommand SHARE, or as provided by a Network shell (In Novell File sharing isπsupported by the network shell on Servers, not locally. Check your networkπdocumentation For more inFormation).ππFile sharing is simple in TP/BP, since the system Variable FileMode definesπin what mode a certain File is opened in:ππConstπ fmReadOnly = $00; (* *)π fmWriteOnly = $01; (* Only one of these should be used *)π fmReadWrite = $02; (* *)ππ fmDenyAll = $10; (* together With only one of these *)π fmDenyWrite = $20; (* *)π fmDenyRead = $30; (* *)π fmDenyNone = $40; (* *)ππ fmNoInherit = $70; (* Set For "No inheritance" *)πππConstruction the FileMode Variable is easy, just add the appropriate values:ππFileMode:=fmReadOnly+fmDenyNone;π (Open File For reading only, allow read and Write.)ππFileMode:=fmReadWrite+fmDenyWrite;π (Open File For both read and Write, deny Write.)ππFileMode:=fmReadWrite+fmDenyAll;π (Open File For both read and Write, deny all.)ππSay you open the File in "fmReadWrite+fmDenyWrite". This will let you readπand Write freely in the File, While other processes can freely read the File.πif another process tries to open the File For writing, that process will getπthe error "Access denied".ππ(fmNoInherit is seldom used - it defines if a childprocess spawn from yourπprocess will be able to use the Filehandle provided by your process.)ππThe FileMode Variable is only used when the File is opened;ππ ...πAssign(F,FileName);πFileMode:=fmReadOnly+fmDenyNone;πReset(F);πFileMode:=<Whatever> (* Changing FileMode here does not affect theπ Files already opened *)ππBy default, FileMode is defined as FileMode:=$02 in TP/BP, this is referredπto as "Compatibility mode" in the TP/BP docs. Two processes accessing theπsame File With this Filemode results in the critical error "Sharingπviolation".π----------------------------------------------------------------------π 11 05-28-9313:46ALL SWAG SUPPORT TEAM LOCKFILE.PAS IMPORT 12 .lë( {π> Does anyone have any multi-tasking/File sharing Units (preferablyπ> With well documented code). Specifically, I need to Write a Programπ> that _may_ be active on one node, and I'd like to open the Files inπ> read-only Form, amung other things, so that I can load that inπ> multi-node (shared) environment.ππ}ππFunction LockFile(f : File) : Boolean; { returns True if lock achieved. }π { if not, File locked by other }π { application running. }ππVarπ r : Registers; {Defined in Dos Unit}π l : LongInt;ππbeginπ r.ah := $5C;π r.al := 0;π Move(f,r.bx,2); {Places File handle into BX register.}π r.cx := 0; {Most significant, region offset (0 - beginning of File)}π r.dx := 0; {Least significant, region offset (0 - beginning of File)}π l := FileSize(f); { Get File size }π r.di := l and $ffff; { Devide File size to most/least parts }π r.si := l div $10000; { For locking the entire File. }π MsDos(r);π LockFile := ((r.flags and 1)=0);π { if carry flag is set File locking failed, reason in AX }πend;ππ{πBTW: to unlock it use the same routine, but change the r.al to 1.ππif this routine fails, it means that the File is locked in the otherπtask, and cannot be used.π} 12 05-28-9313:46ALL SWAG SUPPORT TEAM MAXFILES.PAS IMPORT 9 .lI5 {π>I'm searching For a possibility to access more then 20 (I don't know the exactπ>number) Files at once With TP 7.0 (Real mode). I'll be happy if anyone can postπ>me sourcecode and technical information - technical information alone would beπ>enough, too.ππBoland Magazin 6/92 (Hot Line) Writes:ππThere is error in Dos: it's equal what you in Config.sys after Files= Write,πit can manage only 15 (!) open Files. Here is an Unit to outwit it:π(should be as first, can be not in overlay, entry also in config.sys)π}ππUnit maxFiles;ππInterfaceππConstπ maxFile = 255;π {for 250 open Files}πVarπ index: Integer;π puffer: Array[1..maxFile] of Byte;ππbeginπ For index := 1 to maxFile doπ puffer[index] := $FF;π For index := 1 to 5 doπ puffer[index] := mem[prefixseg:$18 + pred(index)];π memw[prefixseg:$32] := maxFile;π memw[prefixseg:$34] := ofs(puffer);π memw[prefixseg:$36] := seg(puffer);πend.π 13 05-28-9313:46ALL SWAG SUPPORT TEAM TRUENAME.PAS IMPORT 8 .lπ6 {πNORBERT IGLππ> Anyone has got an idea on how to know if a drive is a real one or theπ> result of a SUBST command Any help... welcome :-)ππWell, DOS ( esp. COMMAND.COM ) has a undocumented Commandπcalled TRUENAME, which takes wildcards also.π}ππProgram TrueName;ππusesπ DOS;ππfunction RealName(FakeName : String) : String;πVarπ Temp : String;π Regs : Registers;πbeginπ FakeName := FakeName + #0; { ASCIIZ }π With Regs doπ beginπ AH := $60;π DS := Seg(FakeName);π SI := Ofs(FakeName[1]);π ES := Seg(Temp);π DI := OfS(Temp[1]);π INTR($21, Regs);π DOSERROR := AX * ((Flags And FCarry) shr 7);π Temp[0] := #255;π Temp[0] := CHAR(POS(#0, Temp) - 1);π end;π If DosError <> 0 thenπ Temp := '';π RealName := Temp;πend;ππbeginπ writeln(RealName(Paramstr(0)));πend.π 14 05-29-9322:21ALL GAYLE DAVIS Set File Time (TOUCH) IMPORT 13 .lº& (* FT.PAS *)π(* Set file to a specific date *)ππUSES TPCrt, Dos, Misc, TimeDate;πVARπ f : TEXT;π h, m, s, hund : WORD; { For GetTime}π ftime : LONGINT; { For Get/SetFTime}π dt : DateTime; { For Pack/UnpackTime}π DateS : DateStr;π FName : STRING;ππPROCEDURE Syntax;πBEGINπ ResetAttr (7);π CLRSCR;π GOTOXY (1, 24);π WRITELN ('FT.EXE GDSOFT (c) 1992');π WRITELN ('Usage : FT filename date', #07);π HALT (1);πEND;ππFUNCTION UpperCase (InpStr : STRING) : STRING;ππVAR i : INTEGER;ππBEGINπ FOR i := 1 TO LENGTH (InpStr) DOπ UpperCase [i] := UPCASE (InpStr [i]);π UpperCase [0] := InpStr [0]πEND;ππFUNCTION LeadingZero (w : WORD) : STRING;πVARπ s : STRING;πBEGINπ STR (w : 0, s);π IF LENGTH (s) = 1 THENπ s := '0' + s;π LeadingZero := s;πEND;ππBEGINπ ResetAttr (7);π CLRSCR;π IF (PARAMCOUNT < 1) OR NOT Exist (PARAMSTR (1) ) THEN Syntax;π FName := UpperCase (PARAMSTR (1) );π IF NOT ValidDate (PARAMSTR (2) ) THEN DateS := PlainDate ELSE DateS := PARAMSTR (2);π ASSIGN (f, FName);π RESET (f);π GETFTIME (f, ftime); { Get creation time }π UNPACKTIME (ftime, dt);π WRITELN ('File ', FName, ' created at ', LeadingZero (dt.hour),π ':', LeadingZero (dt.min), ':',π LeadingZero (dt.sec), ' on ', dt.Month, '/', dt.day, '/', dt.year);π WITH dt DOπ BEGINπ FTime := PackDateTime (DateS, PlainTime);π WRITELN ('Setting file datestamp to ', MakeSlashDate (DateS) );π SETFTIME (f, ftime);π END;π CLOSE (f); { Close file }πEND.ππππ 15 06-08-9308:24ALL SWAG SUPPORT TEAM File Exist in Assembler IMPORT 13 .l8« {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}π{$M 16384,0,655360}ππ{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─πMsg : 193 of 292πFrom : Wilbert van Leijen 2:281/256.14 14 May 93 19:29πTo : Vince Laurent 1:382/10.0πSubj : a few questions...π────────────────────────────────────────────────────────────────────────────────π07 May 93, Vince Laurent writes to All:ππ VL> 1. What is the quickest way to check for the existance of a file?π VL> I am going to be running the application on a network and wouldπ VL> like to minimize network traffic.ππYou cannot bypass the file server for this purpose, the reason should beπobvious. So peer-to-peer communication protocols are out.ππSuggestion: obtain the file's attributes using INT 21h, AH=43h, DS:DX -> ASCIIZπfilename.πIf this call sets the carry flag, the file doesn't exist. Otherwise, it does.πAdvantage: no need for an attempt to open it.}ππFunction FileExist(filename : String) : Boolean; Assembler;ππASMπ PUSH DSπ LDS SI, [filename] { make ASCIIZ }π XOR AH, AHπ LODSBπ XCHG AX, BXπ MOV Byte Ptr [SI+BX], 0π MOV DX, SIπ MOV AX, 4300h { get file attributes }π INT 21hπ MOV AL, Falseπ JC @1 { fail? }π INC AXπ@1: POP DSπend; { FileExist }ππ 16 06-08-9308:25ALL SWAG SUPPORT TEAM Binary Key Search - File IMPORT 27 .ld« {===========================================================================π BBS: Canada Remote SystemsπDate: 05-31-93 (20:29) Number: 24331πFrom: HERB BROWN Refer#: NONEπ To: ERIC GIVLER Recvd: NOπSubj: USERS FILE Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πOn this day, <May 28 17:32>, Eric Givler (1:270/101.15@fidonet) noted:π EG> How would this help? You'd still have to search the entireπ EG> INDEX file LINEARLY, correct? Or would you have the INDEX sorted?π EG> If so, how would you keep it sorted? More input would REALLY beπ EG> appreciated!ππThis is code for a binary "split and search" method. Anyways, thats justπsomething I call it. Actually, it's a rudimentary binary search.ππSuppose you had a key record of }ππ key = recordπ reference : Longint; { room for a lot of records }π KeySearchField : String30; { The key string to be stored}π end; { Note, several smaller strings could be put together to make theπ search critical, i.e., keysearchField:=First+second+ThirdName;π As long as the field length stays less than or equal to what youπ defined }ππ{Then using a function that would return a boolean value, i.e., true if dataπmatches, false if not found, then it would look like so.. }ππFunction FindKey( VAR AKey : AKeyFile;π VAR AKeyRef : Longint;π FindMe : String80): Boolean;ππVAR High,Low,Mid : Longint; { For collision processing }π Target : Key;π Gotit : Boolean;π Collison : Boolean;π NumRecs : Longint;πππbeginπ AKeyRef :=0;π NumRecs := FileSize(AKey); {Get the number of records stored in file}ππ High := NumRecs;π Low := 0;π Mid := (Low + High) DIV 2 { Split point }π FindKey := False;π Gotit := False;π Collision := False;π If NumRecs > 0 Then {the file is not empty }π Repeatπ Seek(AKey,Mid);π Read(Akey,Target);π {Was there a position collision ??}π IF (Low = Mid) OR (High = Mid) the Collision := True;π IF Findme := Target.KeySearchField Then { Yay ! }π beginπ Gotit := True;π FindKey := True;π AKeyRef := Target.Reference;π Endπ Else { Divide in half and try it again..}π Beginπ If FindMe > Target.KeySearchField then Low := Midπ Else High := Mid;π Mid := (Low + High + 1) DIV 2;π AKeyRef := Midπ Endπ Until Collision or Gotit;πEnd;ππ(*πThis is a working example. There are some minor precautions that need to beπnoted, though. This will only work on sorted data, for one. The data can beπsorted with a Quick Sort and the key file re-written in sorted order. Theπadvantage here is the actual data file need not be sorted at all.ππAny time you work with a data base, get into the habit of ALWAYS including aπdeleted tag field. The above example lacks this, though.ππThis is just one of many ways of searching a database. Professional <grin>πapplications would probably be better suited for AVL trees or Btrees.ππBuilding an array "cache" helps speed up processing as well. That is wholeπ'nuder ball game, though.. *)π 17 06-22-9309:22ALL SWAG SUPPORT TEAM View File Object IMPORT 65 .lÇV { File Viewer Object }ππuses Dos, Crt;ππconstπ PrintSet: set of $20..$7E = [ $20..$7E ];π ExtenSet: set of $80..$FE = [ $80..$FE ];π NoPrnSet: set of $09..$0D = [ $09, $0A, $0D ];ππtypeπ CharType = ( Unknown, Ascii, Hex );π DataBlock = array[1..256] of byte;π Viewer = objectπ XOrg, YOrg,π LineLen, LineCnt, BlockCount : integer;π FileName : string;π FileType : CharType;π procedure FileOpen( Fn : string;π X1, Y1, X2, Y2 : integer );π function TestBlock( FileBlock : DataBlock;π Count : integer ): CharType;π procedure ListHex( FileBlock : DataBlock;π Count, Ofs : integer );π procedure ListAscii( FileBlock : DataBlock;π Count : integer );π end;ππ Finder = object( Viewer )π procedure Search( Fn, SearchStr : string;π X1, Y1, X2, Y2 : integer );π end;ππprocedure Finder.Search;π varπ VF : file; Result1, Result2 : word;π BlkOfs, i, j, SearchLen : integer;π SearchArray : array[1..128] of byte;π EndFlag, BlkDone, SearchResult : boolean;π FileBlock1, FileBlock2, ResultArray : DataBlock;π beginπ BlockCount := 0;π XOrg := X1;π YOrg := Y1;π LineLen := X2;π LineCnt := Y2;π FileType := Unknown;π SearchLen := ord( SearchStr[0] );π for i := 1 to Searchlen doπ SearchArray[i] := ord( SearchStr[i] );π for i := 1 to sizeof( ResultArray ) doπ ResultArray[i] := $00;ππ assign( VF, Fn );π {$I-} reset( VF, 1 ); {$I+}π if IOresult = 0 thenπ beginπ EndFlag := false;π BlkDone := false;π SearchResult := false;π BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );π EndFlag := Result2 <> sizeof( FileBlock2 );π repeatπ FileBlock1 := FileBlock2;π Result1 := Result2;π FileBlock2 := ResultArray;π if not EndFlag thenπ beginπ BlockRead( VF, FileBlock2, sizeof( FileBlock2 ), Result2 );π inc( BlockCount );π EndFlag := Result2 <> sizeof( FileBlock2 );π end else BlkDone := True;π for i := 1 to Result1 doπ beginπ if SearchArray[1] = FileBlock1[i] thenπ beginπ BlkOfs := i-1;π SearchResult := true;π for j := 1 to SearchLen doπ beginπ if i+j-1 <= Result1 thenπ beginπ if SearchArray[j] = FileBlock1[i+j-1] thenπ ResultArray[j] := FileBlock1[i+j-1] elseπ beginπ SearchResult := false;π j := SearchLen;π end;π end elseπ if SearchArray[j] = FileBlock2[i+j-257] thenπ ResultArray[j] := FileBlock2[i+j-257] elseπ beginπ SearchResult := false;π j := SearchLen;π end;π end;π if SearchResult thenπ beginπ for j := SearchLen+1 to sizeof( ResultArray ) doπ if i+j-1 <= Result1π then ResultArray[j] := FileBlock1[i+j-1]π else ResultArray[j] := FileBlock2[i+j-257];π i := Result1;π end;π end;π end;π until BlkDone or SearchResult;π if SearchResult thenπ beginπ writeln( 'Search string found in file block ', BlockCount,π ' beginning at byte offset ', BlkOfs, ' ...' );π writeln;π if FileType = Unknown thenπ FileType := TestBlock( ResultArray,π sizeof( ResultArray ) );π case FileType ofπ Hex : ListHex( ResultArray, sizeof( ResultArray ), BlkOfs );π Ascii : ListAscii( ResultArray, sizeof( ResultArray ) );π end;π end else writeln( '"', SearchStr, '" not found in ', FN );π close( VF );π window( 1, 1, 80, 25 );π end else writeln( Fn, ' invalid file name!' );π end;ππprocedure Viewer.FileOpen;π varπ VF : file; Ch : char;π Result, CrtX, CrtY : word;π EndFlag : boolean;π FileBlock : DataBlock;π beginπ BlockCount := 0;π XOrg := X1;π YOrg := Y1;π LineLen := X2;π LineCnt := Y2;π FileType := Unknown;π assign( VF, Fn );π {$I-} reset( VF, 1 ); {$I+}π if IOresult = 0 thenπ beginπ window( X1, Y1, X1+X2-1, Y1+Y2-1 );π writeln;π EndFlag := false;π repeatπ BlockRead( VF, FileBlock, sizeof( FileBlock ), Result );π inc( BlockCount );π EndFlag := Result <> sizeof( FileBlock );π if FileType = Unknown thenπ FileType := TestBlock( FileBlock, Result );π case FileType ofπ Hex : ListHex( FileBlock, Result, 0 );π Ascii : ListAscii( FileBlock, Result );π end;π if not EndFlag thenπ beginπ CrtX := WhereX; CrtY := WhereY;π if WhereY = LineCnt thenπ begin writeln;π dec( CrtY ); end;π gotoxy( 1, 1 ); clreol;π write(' Viewing: ', FN );π gotoxy( 1, LineCnt ); clreol;π write(' Press (+) to continue, (Enter) to exit: ');π Ch := ReadKey; EndFlag := Ch <> '+';π gotoxy( 1, LineCnt ); clreol;π gotoxy( CrtX, CrtY );π end;π until EndFlag;π close( VF );π sound( 440 ); delay( 100 );π sound( 220 ); delay( 100 ); nosound;π window( 1, 1, 80, 25 );π end else writeln( Fn, ' invalid file name!' );π end;ππfunction Viewer.TestBlock;π varπ i : integer;π beginπ FileType := Ascii;π for i := 1 to Count doπ if not FileBlock[i] in NoPrnSet+PrintSet thenπ FileType := Hex;π TestBlock := FileType;π end;ππprocedure Viewer.ListHex;π constπ HexStr: string[16] = '0123456789ABCDEF';π varπ i, j, k : integer;π beginπ k := 1;π repeatπ write(' ');π j := (BlockCount-1) * sizeof( FileBlock ) + ( k - 1 ) + Ofs;π for i := 3 downto 0 doπ write( HexStr[ j shr (i*4) AND $0F + 1 ] );π write(': ');π for i := 1 to 16 doπ beginπ if k <= Count thenπ write( HexStr[ FileBlock[k] shr 4 + 1 ],π HexStr[ FileBlock[k] AND $0F + 1 ], ' ' )π else write( ' ' );π inc( k );π if( i div 4 = i / 4 ) then write(' ');π end;π for i := k-16 to k-1 doπ if i <= Count thenπ if FileBlock[i] in PrintSet+ExtenSetπ then write( chr( FileBlock[i] ) )π else write('.');π writeln;π until k >= Count;π end;ππprocedure Viewer.ListAscii;π varπ i : integer;π beginπ for i := 1 to Count doπ beginπ write( chr( FileBlock[i] ) );π if WhereX > LineLen then writeln;π if WhereY >= LineCnt thenπ beginπ writeln;π gotoxy( 1, LineCnt-1 );π end;π end;π end;ππ{=============== end Viewer object ==============}ππvarπ FileFind : Finder;πbeginπ clrscr;π FileFind.Search( ParamStr(0), { file to search }π 'Press any key', { search string }π 1, 1, 80, 25 ); { display window }π gotoxy( 1, 25 ); clreol;π write( 'Press any key to continue: ');π while not KeyPressed do;πend. 18 07-16-9306:07ALL ROB PERELMAN Find Data at end of EXE IMPORT 21 .lQc ===========================================================================π BBS: Canada Remote SystemsπDate: 06-24-93 (15:37) Number: 27580πFrom: ROB PERELMAN Refer#: NONEπ To: ALL Recvd: NO πSubj: End of EXE Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πThis is a unit I wrote but it crashed a few times on me, so here is anπupdated unit for anyone's use. Remember not to use it from the TPπeditor because if you compile to memory, PARAMSTR(0) is the editor, andπif you compile to disk, you will not have any data.ππUnit ExeEnd;ππInterfaceππVar EndOfExe: LongInt; {Shows the end of the EXE file}π ExeFile: File; {The EXE file positioned at the end}π Data: Boolean; {If there is data after the EXE}ππImplementationππType EXEHeader=Recordπ ID: Word; { EXE file id }π ByteMod: Word; { Load module image size mod 512 }π Pages: Word; { File size (including header) div 512 }π RelocItems: Word; { Number of relocation table items }π Size: word; { Header size in 16-byte paragraphs }π MinParagraphs: Word; { Minimum number of paragraphs above program }π MaxParagraphs: Word; { Maximum number of paragraphs above program }π StackSeg: Word; { Displacement of stack segment }π SPReg: Word; { Initial SP register value }π CheckSum: Integer; { Word checksum - negative sum (not used) }π IPReg: Word; { Initial IP register value }π CodeSeg: Word; { Displacement of code segment }π FirstReloc: Word; { First relocation item }π OvlN: Word { Overlay number }π End;ππConst CorrectExe=$5A4D;ππVar Exe: EXEHeader;π ReadIn: Integer;π OldExitProc: Pointer;ππProcedure CloseExe; Far;πBeginπ ExitProc:=OldExitProc;π Close(ExeFile);πEnd;ππBeginπ OldExitProc:=ExitProc;π ExitProc:=@CloseExe;π Assign(ExeFile, ParamStr(0));π Reset(ExeFile, 1);π BlockRead(ExeFile, Exe, SizeOf(Exe), ReadIn);π With Exe do If (ReadIn<>SizeOf(Exe)) or (ID<>CorrectExe) then EndOfExe:=0π Else EndOfExe:=Pages*512+ByteMod-512;π Seek(ExeFile, EndOfExe);π Data:=Not EOF(ExeFile);πEnd.ππ * QMPro 1.50 4 * "Call waiting", great if you have two friendsπππ--- WM v3.00/92-0215π * Origin: High Country East, Ramona, CA (619)-789-4391 (1:202/1308.0)π 19 07-16-9306:11ALL KELD R. HANSEN Self Modify EXE File IMPORT 52 .lQc ===========================================================================π BBS: Canada Remote SystemsπDate: 07-03-93 (11:56) Number: 29412πFrom: KELD R. HANSEN Refer#: NONEπ To: JON JASIUNAS Recvd: NO πSubj: Re: Self-modifying .EXEs Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πIn a message dated 28 Jun 93, Jon Jasiunas (1:273/216.0) wrote:ππ > Here's the code I use for my self-modifying .EXEs. I've used itπ > successfully in several applications.ππIt works fine (I have one similar of my own), but it doesn't take care of DPMIπprograms and won't work if your "customer" PKLITEs the program.ππTYPEπ ExeHeaderDOS = RECORDπ { 00 } Signature : ARRAY[1..2] OF CHAR;π { 02 } LastPageSize : WORD;π { 04 } Pages : WORD;π { 06 } RelocItems : WORD;π { 08 } HeaderSizePara : WORD;π { 0A } MinMemPara : WORD;π { 0C } MaxMemPara : WORD;π { 0E } EntrySS : WORD;π { 10 } EntrySP : WORD;π { 12 } CheckSum : WORD;π { 14 } EntryIP : WORD;π { 16 } EntryCS : WORD;π { 18 } FirstRelocItemOfs : WORD;π { 1A } OverlayNumber : WORD;π Reserved : ARRAY[$1C..$23] OF BYTE;π { 24 } IdentifierOEM : WORD;π { 26 } InformationOEM : WORD;π ReservedToo : ARRAY[$28..$3B] OF BYTE;π { 3C } NewExeHeaderOfs : LONGINTπ END;π ExeHeaderOS2 = RECORDπ Signature : ARRAY[1..2] OF CHAR;π LinkerMajorVers : BYTE;π LinkerMinorVers : BYTE;π EntryTableOfs : WORD;π EntryTableSize : WORD;π CRC : LONGINT;π ModuleFlags : WORD;π SegmentNoDGROUP : WORD;π HeapSize : WORD;π StackSize : WORD;π EntryIP : WORD;π EntryCS : WORD;π EntrySP : WORD;π EntrySS : WORD;π SegmentTableEntries : WORD;π ModuleRefEntries : WORD;π NonResNameTableSize : WORD;π SegTableOfs : WORD;π ResourceTableOfs : WORD;π ResNamesTableOfs : WORD;π ModuleRefTableOfs : WORD;π ImpNamesTableOfs : WORD;π NonResNamesTableOfs : LONGINT;π MovableEntryPoints : WORD;π AlignmentUnitPower : WORD;π ResourceTableEntries: WORD;π TargetOS : BYTE;π WindowsFlags : BYTE;π FastLoadStart : WORD;π FastLoadSize : WORD;π Reserved : WORD;π WindowsVers : WORDπ END;π SegTableRec = RECORDπ Start : WORD;π Size : WORD;π Flags : WORD;π MinSize : WORDπ END;π FileOffset = LONGINT;ππPROCEDURE ReadOnly;π INLINE($C6/$06/FileMode/$A0);ππPROCEDURE ReadWrite;π INLINE($C6/$06/FileMode/$02);ππ{ ExeOfs returns the offset of the item V in the .EXE file of the currently }π{ running program. Use this to get the offset of a configuration record that }π{ is located in the .EXE file (remember that you must declare it as a typed }π{ constant to include it in the .EXE file) }ππ{$IFDEF DPMI }πFUNCTION ExeOfs(CONST V) : FileOffset;π VARπ HeaderDOS : ExeHeaderDOS;π HeaderOS2 : ExeHeaderOS2;π FIL : FILE;π CodeSeg,Seg : WORD;π SegTab : SegTableRec;ππ BEGINπ ReadOnly;π ASSIGN(FIL,ParamStr(0)); RESET(FIL,1);π BLOCKREAD(FIL,HeaderDOS,SizeOf(ExeHeaderDOS));π IF HeaderDOS.Signature<>'MZ' THENπ ExeOfs:=-1π ELSE BEGINπ SEEK(FIL,HeaderDOS.NewExeHeaderOfs);π BLOCKREAD(FIL,HeaderOS2,SizeOf(ExeHeaderOS2));π IF HeaderOS2.Signature<>'NE' THENπ ExeOfs:=-1π ELSE BEGINπ ASMπ MOV BX,WORD PTR V+2π MOV CX,SSπ CMP BX,CXπ JE @STACKπ XOR AX,AXπ VERW BXπ JZ @OUTπ MOV ES,BXπ MOV AX,ES:[0000h]π JMP @OUTπ @STACK: MOV AX,HeaderOS2.EntrySSπ @OUT: MOV CodeSeg,AXπ END;π IF CodeSeg<>0 THEN BEGINπ SEEK(FIL,HeaderDOS.NewExeHeaderOfs+HeaderOS2.SegTableOfs+π PRED(CodeSeg)*SizeOf(SegTableRec));π BLOCKREAD(FIL,SegTab,SizeOf(SegTableRec)) ENDπ ELSE BEGINπ SEEK(FIL,HeaderDOS.NewExeHeaderOfs+HeaderOS2.SegTableOfs);π FOR Seg:=1 TO HeaderOS2.SegmentTableEntries DO BEGINπ BLOCKREAD(FIL,SegTab,SizeOf(SegTableRec));π IF (SegTab.Start>0) AND (SegTab.Flags AND $0001=$0001) THEN BREAKπ ENDπ END;π ExeOfs:=SegTab.Start SHL HeaderOS2.AlignmentUnitPower+OFS(V)π ENDπ END;π CLOSE(FIL);π ReadWriteπ END;π{$ELSE }πFUNCTION ExeOfs(CONST V) : FileOffset;π VARπ HeaderDOS : ExeHeaderDOS;π FIL : FILE;ππ BEGINπ ReadOnly;π ASSIGN(FIL,ParamStr(0)); RESET(FIL,1);π BLOCKREAD(FIL,HeaderDOS,SizeOf(ExeHeaderDOS));π CLOSE(FIL);π ExeOfs:=(HeaderDOS.HeaderSizePara+(SEG(V)-(PrefixSeg+$0010)))*16+OFS(V)π END;π{$ENDIF }π 20 08-18-9312:21ALL JOSE ALMEIDA Check for a file IMPORT 8 .l∞Φ { Checks the existance of a file.π Part of the Heartware Toolkit v2.00 (HTfile.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION File_Found(FName : string) : integer;π{ DESCRIPTION:π Checks the existance of a file.π SAMPLE CALL:π I := File_Found('C:\COMMAND.COM');π RETURNS:π 0 : file was foundπ 18 : file was NOT foundπ else : DosError code }ππvarπ SR : SearchRec;ππBEGIN { File_Found }π {$I-}π FindFirst(FName,Archive,SR);π File_Found := DosError;π {$I+}πEND; { File_Found }π 21 08-18-9312:22ALL JOSE ALMEIDA Get size of file IMPORT 9 .l╗ { Gets size of existing file, in bytes.π Part of the Heartware Toolkit v2.00 (HTfile.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππPROCEDURE Get_File_Size(FName : string;π var FSize : longint;π var Error : word);π{ DESCRIPTION:π Gets size of existing file, in bytes.π SAMPLE CALL:π Get_File_Size('C:\COMMAND.COM',FSize,Error);π RETURNS:π FSize : 0 if errorπ else file sizeπ Error : DosError code }ππvarπ SR : SearchRec;ππBEGIN { Get_File_Size }π {$I-}π FindFirst(FName,Archive,SR);π Error := DosError;π {$I+}π if Error = 0 thenπ FSize := SR.Sizeπ elseπ FSize := 0;πEND; { Get_File_Size }π 22 08-27-9321:20ALL MARCO MILTENBURG File and Record Locks IMPORT 26 .l {πMARCO MILTENBURGππ> Currently I'm writing a Program which must be able to handle multitaskπ> evironments. But as I'm trying to Write a Record which is open in anotherπ> Window (of DesqView for instance) than a runtime error 5 appears. Seemsπ> logical. But how do I 'lock' the Record, what are the attibutes, and whatπ> must the Program do if it can't open a Record???ππ Locking isn't that difficult... First of all, do you have to keep theπFile available For anybody else (in another task) or not. if not, use theπFilesharing bits when you're opening the File. They are :ππbit 0-2 = 000 - read permission For your own applictionπ 001 - Write permission For you own applicationπ 010 - both read and Write permission For you own applicationππbit 3 = 0 - Always zero!ππbit 4-6 = 000 - compatibilty mode. Share the File whenever possible.π 001 - reading and writing not allowed For other applicationsπ 010 - writing not allowed For other applications (usefull whenπ you're gonna read the File, so others can not update it)π 011 - reading not allowed For other applications (usefull whenπ you're gonna update the File and others may not read it).π 100 - Full access For other applications (dangerous in my point ofπ view!).ππbit 7 = 0 - Lower process owns Fileπ 1 - File only For current process.ππSet the bits to your needs and assign the value to FileMode before opening theπFile. For example, I want to read a File which must be locked completly. Isπmust use the value 00010000b which is $10. So use FileMode = $10 before openingπthe File. Please note that FileMode only take affect on Files which areπdeclared as ': File' or ': File of ....'. It's not supported on ': Text' Files.πif you want to lock these Files, use the next method.ππif you only want to lock a single Record of a File (or an entier File) you canπuse the following Function :πππOoh BTW: This will only work With Dos 3.0+ (of course ;-) With SHARE loaded.π}ππFunction FileLocking(Action : Byte;π Handle : Word;π Start, end : LongInt) : Boolean;πVarπ Regs : Registers;πbeginπ Regs.AH := $5C;π Regs.AL := Action;π Regs.BX := Handle;π Regs.CX := Hi(Start);π Regs.DX := Lo(Start);π Regs.DI := Lo(end);π Regs.SI := Hi(end);π Intr($21, Regs);π FileLocking := ((Regs.FLAGS and $01) = 0);πend;ππ{πUse For Action '0' to lock or '1' to unlock the File. The funtion returns Trueπwhen succesfull. The Handle Variable must contain the Filehandle, assigned byπDos. For TextFiles you can obtain this handle With :ππ TextRec(T).Handleππwhere T is the TextFile (declared With T : Text). I don't know how to obtainπthe Filehandle of another FileType at the moment. I will have to look For it.πStart and end contain the starting and ending position (in Bytes) from what youπwant to lock (for Typed Files, they can easaly be calculated using FilePos andπSizeOf(....Record) etc..). if you want to lock the entire File, use 0 For startπand $FFFFFFFF For end. Locking beyond the end of the File doesn't result in anπerror!π}π 23 08-27-9321:22ALL JASON GROOMS Delete a file QUICK IMPORT 11 .l {πJASON GROOMSππ| Can anyone give me some code for a procedure to delete a file? Iπ| cannot use the DOS EXEC procedure, due to memory conflicts, but I canπ| call on interrupts.ππHere is a routine to add to your toolbox which will delete a fileπthrough DOS.π}ππfunction DeleteFile(FN : PathStr) : Boolean;πvarπ Regs : Registers;πbeginπ FN := FN + #0; { Add NUL chr for DOS }π Regs.AH := $41;π Regs.DX := Ofs(FN) + 1; { Add 1 to bypass length byte }π Regs.DS := Seg(FN);π MsDos(Regs);π DeleteFile := NOT (Regs.Flags AND $0 = $0)πend;ππ{ Here is another routine to rename a file through DOS. }ππfunction RenameFile(ON, NN : PathStr) : Boolean;πvarπ Regs : Registers;πbeginπ ON := ON + #0; { Add NUL chr for DOS }π NN := NN + #0; { Add NUL chr for DOS }π Regs.AH := $56;π Regs.DX := Ofs(ON) + 1; { Add 1 to bypass length byte }π Regs.DS := Seg(ON);π Regs.DI := Ofs(NN) + 1; { Add 1 to bypass length byte }π Regs.ES := Seg(NN);π MsDos(Regs);π RenameFile := NOT (Regs.Flags AND $0 = $0)πend;ππ{πThese two routines require the Dos unit.ππ ** Be warned that the delete file routine does not confirm theπ delete, meaning it WILL delete the file if it exists so useπ with care.ππ} 24 08-27-9321:22ALL SEAN PALMER Faster File Exists IMPORT 15 .l {πSEAN PALMERππI just ran some timings, which are gonna be affected by SMARTDRV.EXEπbeing loaded, but I took that into account (ran multiple times on sameπfile, and took timings on second/subsequent runs, to make sure alwaysπgot cache hits)ππWhat I got was that FileExists below and my modified version of thatπfileExist3 function that's been floating around this echo for a whileπ(no bug) both run neck and neck... it's amazing... both are slightlyπfaster than FileExist2 and lots lots faster than the 'reset,πfileExist=(ioresult=0)' type thing that most people still seem to use...ππI'd recommend using the first one below as it's really short...π}ππusesπ dos;ππ{ Tied for fastest }πfunction fileExists(var s : string) : boolean;πbeginπ fileExists := fSearch(s, '') <> '';πend;ππ{ 2nd }πfunction fileExist2(var s : string) : boolean;πvarπ r : searchrec;πbeginπ findfirst(s, anyfile, r);π fileExist2 := (dosError = 0);πend;ππ{ Tied for fastest }πfunction fileExist3(var s : string) : boolean; assembler;πasmπ push dsπ lds si, s { need to make ASCIIZ }π cldπ lodsb { get length; si now points to first char }π xor ah, ahπ mov bx, axπ mov al, [si+bx] { save byte before placing terminating null }π push axπ mov byte ptr [si+bx],0π mov dx, siπ mov ax, $4300 { get file attributes }π int $21π mov al, 1 { if carry set, fail }π pop dxπ mov [si+bx], dl { restore byte }π pop dsπend;ππ{ Slowest }πfunction fileExist4(var s : string) : boolean;πvarπ f : file;πbeginπ assign(f,s);π {$I-}π reset(f);π {$I+}π if ioresult = 0 thenπ beginπ close(f);π fileExist4 := true;π endπ elseπ fileExist4 := false;πend;ππ 25 08-27-9321:23ALL LOU DUCHEZ Set DOS Filemode IMPORT 7 .l LOU DUCHEZππ>Could someone post all the different File Modes availl with FileMode, and aπ>short descript of each one?ππThe FileMode byte reserves certain bits to specify different capabilities.πThey are:ππ76543210π--------π.....000 - Read accessπ.....001 - Write accessπ.....010 - Read/write accessπ....0... - Reserved - must be zeroπ.000.... - Sharing mode - compatibility mode ["no sharing"?]π.001.... - Sharing mode - read/write access deniedπ.010.... - Sharing mode - write access deniedπ.011.... - Sharing mode - read access deniedπ.100.... - Sharing mode - full access permittedπ0....... - Inherited by child processesπ1....... - Private to current processππI got this out of a pocket DOS/BIOS reference -- hope it helps.π 26 08-27-9321:59ALL MICHAEL REECE File spliting IMPORT 26 .l {πMICHAEL REECEππ> Hi! I was wondering. How would you in Turbo Pascal be able to split aπ> single File into two. I want it to split it to a precise Byte For bothπ> Files. I want to be able to combine to Files together and split it to itsπ> original sizes and still be able to work (that no codes are missing etc.).ππThe following is kludgy and only semi tested, but may help you get started.πIt's an old little thing I wrote to split large Files to put on a floppy, andπthen put it back together again.π}ππ(* usage: split <Filename> <new-name-for-second-half>π ex: split nodelist.zip nodelist.zi2π*)πProgram Split;ππConstπ MaxBuffSize = 61140;ππTypeπ BuffType = Array[1..MaxBuffSize] of Byte;ππVarπ F1, F2 : File;π Mid : LongInt;π Buffer : ^BuffType;π BuffSize : LongInt;π NumRead,π NumWrite : Word;ππbeginπ Writeln('Splitting File "', ParamStr(1), '"');π Assign(F1, ParamStr(1));π Reset(F1, 1);π Mid:=FileSize(F1) div 2; { calculate midpoint }π Writeln(' Original size: ', FileSize(F1));π Writeln(' File midpoint: ', Mid);π Writeln('Creating File "', ParamStr(2), '"');π Assign(F2, ParamStr(2));π ReWrite(F2, 1);π Writeln('Memory available: ', MaxAvail); { allocate max buffer }π BuffSize:=MaxAvail;π if (BuffSize > MaxBuffSize) thenπ BuffSize:=MaxBuffSize;π GetMem(Buffer, BuffSize);π Writeln(' Buffer size: ', BuffSize);π Writeln('Seeking to midpoint');π Seek(F1, Mid);π Writeln(' Copying remainder of File');π While (not Eof(F1)) doπ beginπ BlockRead(F1, Buffer^, BuffSize, NumRead);π BlockWrite(F2, Buffer^, NumRead, NumWrite);π if (NumRead <> NumWrite) thenπ beginπ Writeln('Error in copy');π Halt(1);π end;π end;π Writeln('Seeking to midpoint');π Seek(F1, Mid);π Writeln(' Truncating File');π Truncate(F1);π Writeln('Closing Files');π Close(F2);π Close(F1);π Writeln('Done.');πend.ππ{ That one splits a File in half. }ππ(* usage: splice <Filename> <name-of-second-half>π ex: split nodelist.zip nodelist.zi2π this will append/splice nodelist.zi1 to nodelist.zipπ*)πProgram Splice;ππConstπ MaxBuffSize = 61140;ππTypeπ BuffType = Array[1..MaxBuffSize] of Byte;ππVarπ F1, F2 : File;π Buffer : ^BuffType;π BuffSize : LongInt;π NumRead,π NumWrite : Word;ππbeginπ Writeln('Splicing File "', ParamStr(1), '"');π Assign(F1, ParamStr(1));π Reset(F1, 1);π Writeln(' Original size: ', FileSize(F1));π Writeln('Appending File "', ParamStr(2), '"');π Assign(F2, ParamStr(2));π Reset(F2, 1);π Writeln(' Original size: ', FileSize(F1));π Writeln('Memory available: ', MaxAvail); { allocate max buffer }π BuffSize:=MaxAvail;π if (BuffSize > MaxBuffSize) thenπ BuffSize:=MaxBuffSize;π GetMem(Buffer, BuffSize);π Writeln(' Buffer size: ', BuffSize);π Writeln('Seeking to end');π Seek(F1, FileSize(F1));π Writeln(' Copying File');π While (not Eof(F2)) doπ beginπ BlockRead(F2, Buffer^, BuffSize, NumRead);π BlockWrite(F1, Buffer^, NumRead, NumWrite);π if (NumRead <> NumWrite) thenπ beginπ Writeln('Error in copy');π Halt(1);π end;π end;π Writeln('Closing Files');π Writeln('Done.');π Close(F2);π Close(F1);πend.ππ 27 08-27-9322:11ALL SWAG SUPPORT TEAM Wipe file from Disk IMPORT 17 .l {π> I'm looking For a turbo pascal routine that will wipe Filesπ> off of disks the way (or similar to the way) that Norton'sπ> Wipeinfo wipe's Files. I'd like the call to be somethingπ> like wipeFile(fn:String); Preferrably, I would also likeπ> the deleted directory entry wiped to prevent one from seeingπ> what the File that used to be there was named, or how largeπ> it was. Any help would greatly be appreciated.ππ> Here is my wipe File. The directory entry is not cleared.πWell, today an idea occured: clearing directory entries is not asπdifficult as I tought. No Assembler needed, no strange Dos calls, justπplain TP. Here an updated version. Even the CIA won't get your Filesπback!π}ππProcedure DosWipe(Path : PathStr);π{ wipes Files according to Department of Defense standard DOD 5220.22-M }πVarπ DataFile : File;π DirInfo : SearchRec;ππ Procedure WipeFile(Var DataFile : File);π Constπ NullByte : Byte = 0;π FFByte : Byte = $FF;π F6Byte : Byte = $F6;π Varπ Result : Word;π Count : Byte;π Count2 : LongInt;π beginπ Reset(DataFile, 1);π For Count := 1 to 3 doπ beginπ Seek(DataFile,0);π For Count2 := 0 to FileSize(DataFile) - 1 doπ BlockWrite(DataFile, FFByte, 1, result);π Seek(DataFile,0);π For Count2 := 0 to FileSize(DataFile) - 1 doπ BlockWrite(DataFile, NullByte, 1, result);π end;ππ Seek(DataFile, 0);π For Count := 0 to FileSize(DataFile) - 1 doπ BlockWrite(DataFile, F6Byte, 1, result);π Close(DataFile);π end;ππ Procedure ClearDirEntry;π beginπ Reset(DataFile);π Truncate(DataFile); { erase size entry }π Close(DataFile);π Rename(DataFile, 'TMP00000.$$$'); { erase name entry }π end;ππVarπ D : DirStr;π N : NameStr;π E : ExtStr;πbeginπ FSplit(Path, D, N, E);π FindFirst(Path, Archive, DirInfo);ππ While DosError = 0 doπ beginπ Assign(DataFile, D+DirInfo.Name);π WipeFile(DataFile);π ClearDirEntry;π Erase(DataFile);π FindNext(DirInfo);π end;πend;ππ 28 11-02-9305:25ALL ANDREW VICTOR Change File Attr SWAG9311 8 .l {πavictor@cs.sun.ac.za (Andrew Victor 93-42265)ππI want this Program to change the hidden attributes of a directory.ππ - Parameter FileName of Type String is the Name of theπ - subdirectory to hide or un-hide, it can include a path.π}πππProcedure ChangeAttributes(FileName : String);πVarπ AttrFile : File;π Attribute : Word;πbeginπ Assign(AttrFile, FileName);π GetFAttr(AttrFile, Attribute);π if not ((Attribute = $10) or (Attribute = $12)) thenπ beginπ WriteLn;π WriteLn('Not a Directory');π WriteLn;π Exit;π end;π if Attribute = $10 thenπ beginπ SetFAttr(AttrFile, Hidden);π WriteLn;π WriteLn('Directory ', FileName, ' hidden.');π WriteLn;π endπ elseπ beginπ SetFAttr(AttrFile, Directory and not Hidden);π WriteLn;π WriteLn('Directory ', FileName, ' shown.');π WriteLn;π end;πend;π 29 09-26-9310:17ALL DAVID DANIEL ANDERSON Filesize & ZeroByte FilesSWAG9311 21 .l (*πFrom: DAVIDDANIEL ANDERSON Refer#: 2239πSubj: FileSize in DOS Conf: (232) T_Pascal_RππThe FileSize "returns the number of components" in a file. Thus, itπmay not work as you might assume on untyped files, or files of records.ππThe file should be declared as a file of byte or char or as a textπfile, in order to use FileSize.ππAn alternative to FileSize is to use the SearchRec type in the DOSπunit. This program deletes a file if it is 0 bytes. The filespec isπprovided by the user on the command line, and can contain wildcards.π*)ππPROGRAM delete_0_byte_files;πUSES Dos;πVARπ MaybeZero : File of Byte; { the file in question }π DirInfo : SearchRec; { a record of the file }π FMask : PathStr; { entire path as specified by user }π MZName : PathStr; { path of file in question }π FDir : DirStr; { dir of file in question }π FName : NameStr; { name of file in question }π FExt : ExtStr; { ext of file in question }π NZero : Word; { number of files deleted }ππBEGINπ NZero := 0;π IF ParamCount = 1 THENπ FMask := ParamStr(1) { use command line info, if it exists }π ELSE BEGINπ Writeln('You must specify a file_mask, such as "*.*"!');π Halt;π END;π FSplit(FExpand(FMask),FDir,FName,FExt); { split cmdlind info into }π IF (FName = '') THEN { components }π FMask := FMask + '*.*'; { if only a DOS path was specified, }π FindFirst(FMask, Archive, DirInfo); { append a wildcard spec }ππ WHILE DosError = 0 DO { check every valid file for size }π BEGIN { append path to name, to allow }π MZName := FDir+DirInfo.Name; { paths and drives other than current }π Assign(MaybeZero,MZName); { use Assign since Erase can only work }π { on *files*, -not- file names }π IF (DirInfo.Size = 0) THEN BEGIN { THE MEAT! use the SearchRec }π Writeln('Deleting ',MZName); { for determining file size }π Erase(MaybeZero); { give a message and delete it }π NZero := NZero + 1; { incremented counter, of course }π END;ππ FindNext(DirInfo); { look for another matching file }π END;π Writeln('Files Deleted: ',NZero); { simply display total # deleted }πEND.π 30 11-02-9305:46ALL ERIC MILLER Reading GIF File Header SWAG9311 8 .l {πERIC MILLERππ> How does one read/Write a header on a File in TPascal?ππ Easy. Write the header structure as a Type. Then openπ the File as unTyped and blockread the data into a Variableπ of the structure Type. Take GIFs For example:π}ππTypeπ Gif_Header = Record { first 13 Bytes of a Gif }π Sig, Ver : Array[1..3] of Char;π Screen_X,π Screen_Y : Word;π _Packed,π Background,π Pixel_Aspect : Byte;π end;πVarπ F : File; { unTyped File }π G : GIF_Header;πbeginπ Assign(F, 'Filename.gif');π Reset(F, 1); { blockread in Units of one Byte }π Blockread(F, G, SizeOf(G)); { read from File }π Close(F);π With G DOπ beginπ Writeln('Version: ', Sig, Ver);π Writeln('Res: ', Screen_X, 'x', Screen_Y, 'x', 2 SHL (_Packed and 7));π end;πend.π 31 11-21-9309:30ALL GUY MCLOUGHLIN Checking File Open SWAG9311 21 .l {πFrom: GUY MCLOUGHLINπSubj: Checking file openππI'm looking for a way of detecting if a file is currently open,πso my ExitProc can close it when open and not fail when tryingπto close a file that is not open.ππ (* Public-domain demo to check a file variable's *)π (* current file mode. Guy McLoughlin - Oct '93. *)π}ππprogram Test_FileMode_Demo;πusesπ dos;ππ (**** Display current filemode for a file variable. *)π (* *)π procedure DisplayFileMode({input } const fi_IN);π beginπ case textrec(fi_IN).mode ofπ FMclosed : writeln('* File closed');π FMinput : writeln('* File open in read-only mode');π FMoutput : writeln('* File open in write-only mode');π FMinout : writeln('* File open in read/write mode')π elseπ writeln('* File not assigned')π endπ end; (* DisplayFileMode. *)πππ (**** Check for IO file errors. *)π (* *)π procedure CheckForIOerror;π varπ in_Error : integer;π beginπ in_Error := ioresult;π if (ioresult <> 0) thenπ beginπ writeln('Error creating file');π halt(1)π endπ end; (* CheckForIOerror. *)πππvarπ fi_Temp1 : text;π fi_Temp2 : file;ππBEGINπ (* Demo filemodes for a TEXT file variable. *)π writeln('TEXT file variable test');π DisplayFileMode(fi_Temp1);π assign(fi_Temp1, 'TEST.DAT');π DisplayFileMode(fi_Temp1);π {$I-} rewrite(fi_Temp1); {$I+}π CheckForIOerror;π DisplayFileMode(fi_Temp1);π {$I-} close(fi_Temp1); {$I+}π CheckForIOerror;π DisplayFileMode(fi_Temp1);ππ (* Demo filemodes for an UNTYPED file variable. *)π writeln;π writeln('UNTYPED file variable test');π DisplayFileMode(fi_Temp2);π assign(fi_Temp2, 'TEST.DAT');π DisplayFileMode(fi_Temp2);π {$I-} rewrite(fi_Temp2); {$I+}π CheckForIOerror;π DisplayFileMode(fi_Temp2);π {$I-} close(fi_Temp2); {$I+}π CheckForIOerror;π DisplayFileMode(fi_Temp2)πEND.ππ *** NOTE: If you are not using version 7 of Turbo Pascal, changeπ the input parameter of the DisplayFileMode routine fromπ a CONSTANT parameter to a VAR parameter.ππ ie: TP7+ : DisplayFileMode({input } const fi_IN);ππ TP4+ : DisplayFileMode({input } var fi_IN);ππ - Guyπ 32 11-02-9305:42ALL GUY MCLOUGHLIN General File Handler SWAG9311 42 .l {πGUY MCLOUGHLINππ ...Here's one way of creating generic routines to handle any typeπ of file...π}ππprogram Demo_Handle_Many_File_Types;ππusesπ crt;ππtype (* Path string type definition. *)π st_79 = string[79];ππ (* Enumerated type of the file types we want to handle. *)π FileType = (Fchar, FrecA, FrecB, Ftext, Funty);ππ (* First record type definition. *)π recA = recordπ Name : string;π Age : wordπ end;ππ (* Second record type definition. *)π recB = recordπ Unit : word;π City : stringπ end;ππ (* Case-varient multi-file type definition. *)π rc_FileType = recordπ case FT : FileType ofπ Fchar : (Fchar1 : file of char);π FrecA : (FrecA1 : file of recA);π FrecB : (FrecB1 : file of recB);π Ftext : (Ftext1 : text);π Funty : (Funty1 : file)π end;πππ (***** Display I/O error message. *)π (* *)πprocedure ErrorMessage({input }π by_Error : byte;π st_Path : st_79);πvarπ ch_Temp : char;πbeginπ (* If an I/O error occured, then... *)π if (by_Error <> 0) thenπ beginπ writeln;π case by_Error ofπ 2 : writeln('File not found ---> ', st_Path);π 3 : writeln('Path not found ---> ', st_Path);π 4 : writeln('Too many files open');π 5 : writeln('File access denied ---> ', st_Path);π 100 : writeln('Disk read error');π 103 : writeln('File not open ---> ', st_Path)π (* NOTE: The full error code listing code be *)π (* implemented if you like. *)π end;π (* Clear keyboard-buffer. *)π while keypressed doπ ch_Temp := readkey;ππ (* Pause for key-press. *)π writeln('Press any key to continue');π repeat until keypressedπ endπend; (* ErrorMessage. *)ππ(***** Generic open routine to handle many different file types. *)π(* *)πprocedure OpenFile({input } st_Path : st_79;π bo_Create : boolean;π var rc_File : rc_FileType);πbeginπ {$I-}π (* Handle appropriate file type. *)π case rc_File.FT ofπ Fchar : beginπ assign(rc_File.Fchar1, st_Path);π if bo_Create thenπ rewrite(rc_File.Fchar1)π elseπ reset(rc_File.Fchar1)π end;π FrecA : beginπ assign(rc_File.FrecA1, st_Path);π if bo_Create thenπ rewrite(rc_File.FrecA1)π elseπ reset(rc_File.FrecA1)π end;π FrecB : beginπ assign(rc_File.FrecB1, st_Path);π if bo_Create thenπ rewrite(rc_File.FrecB1)π elseπ reset(rc_File.FrecB1)π end;π Ftext : beginπ assign(rc_File.Ftext1, st_Path);π if bo_Create thenπ rewrite(rc_File.Ftext1)π elseπ reset(rc_File.Ftext1)π end;π Funty : beginπ assign(rc_File.Funty1, st_Path);π if bo_Create thenπ rewrite(rc_File.Funty1, 1)π elseπ reset(rc_File.Funty1, 1)π endπ end;π {$I+}π (* Check for I/O error, and display message if needed. *)π ErrorMessage(ioresult, st_Path)ππend; (* OpenFile. *)πππvar (* Array of 5 mulit-file type records. *)π FileArray : array[1..5] of rc_FileType;ππ (* Main program execution block. *)πBEGINπ (* Clear the screen. *)π clrscr;π (* Clear the multi-file type array. *)π fillchar(FileArray, sizeof(FileArray), 0);ππ (* Initialize each file-variable to it's own type. *)π FileArray[1].FT := Fchar;π FileArray[2].FT := FrecA;π FileArray[3].FT := FrecB;π FileArray[4].FT := Ftext;π FileArray[5].FT := Funty;ππ (* Create a new file of type CHAR. *)π OpenFile('D:\TMP18\CHAR.TST', true, FileArray[1]);ππ (* Create a new file of type RecA. *)π OpenFile('D:\TMP18\RECA.TST', true, FileArray[2]);ππ (* Open an existing file of type RecB. *)π OpenFile('D:\TMP18\RECB.TST', false, FileArray[3]);ππ (* Open an existing TEXT file. *)π OpenFile('D:\TMP18\TEXT.TST', false, FileArray[4]);ππ (* Open an existing un-typed file. *)π OpenFile('D:\TMP18\BIN.DAT', false, FileArray[5]);ππEND.π 33 11-02-9305:54ALL HERBERT ZARB Hiding/Unhiding Files SWAG9311 7 .l {πHerbert Zarb <panther!jaguar!hzarb@relay.iunet.it>ππ This simple Program changes the attribute of the File or directory fromπ hidden to archive or vice-versa...π}ππProgram hide_unhide;π{ Accepts two command line parameters :π 1st parameter can be either +h (hide) or -h(unhide).π 2nd parameter must be the full path }πUsesπ Dos;ππConstπ bell = #07;π hidden = $02;π archive = $20;ππVarπ f : File;ππbeginπ if paramcount >= 2 thenπ beginπ Assign(f, paramstr(2));π if paramstr(1) = '+h' thenπ SetFAttr(f, hidden)π elseπ if paramstr(1) = '-h' thenπ SetFAttr(f, Archive)π elseπ Write(bell);π endπ elseπ Write(bell);πend.π 34 11-02-9305:58ALL IAN LIN Increasing a files size SWAG9311 13 .l {πIAN LINππAdd junk to file to increase size. v.2.2. }ππ{$I-,G+,R-,D-,L-}ππUsesπ dos;ππTypeπ buf = array [1..$ffff] of byte;ππVarπ c, k,π size : longint;π s, v : word;π f : file;π b : ^buf;ππBeginπ writeln('JUNK v2.2');π if paramcount = 0 thenπ beginπ writeln('Help screen. Syntax:');π writeln(paramstr(0),' <infile> <bytes>');π writeln('<infile>: source file -- <bytes>: bytes to add to source file');π writeln('Error level codes');π writeln('0: Normal execution or show help screen (no parameters)');π writeln('1: Not enough parameters. Must have specify a file and size.');π writeln('2: Invalid size specified for <bytes>');π halt(0);π End;ππ if paramcount = 1 thenπ beginπ writeln('Not enough parameters.');π halt(1);π End;ππ assign(f, paramstr(1));π val(paramstr(2), size, v);π if (v <> 0) or (size < 0) thenπ beginπ writeln('Invalid number in <bytes>. Run ', paramstr(0), ' alone for help.');π halt(2);π end;ππ reset(f, 1);π if ioresult = 0 thenπ seek(f, filesize(f))π elseπ rewrite(f, 1);π k := size div sizeof(buf);π s := size mod sizeof(buf);π randomize;π new(b);π for c := 1 to sizeof(buf) doπ b^[c] := random(128) + 128;ππ while k > 0 doπ beginπ blockwrite(f, b^, sizeof(buf));π dec(k);π end;ππ if s > 0 thenπ blockwrite(f, b^, s);π writeln('Wrote ', size, ' bytes to ', fexpand(paramstr(1)));π writeln('Total size of ', fexpand(paramstr(1)), ' is ', filesize(f));π close(f);π dispose(b);πend.ππ 35 09-26-9309:04ALL MARTIN RICHARDSON Check for file EXIST SWAG9311 6 .l {*****************************************************************************π * Function ...... Exist()π * Purpose ....... Checks for the existance of a file/directoryπ * Parameters .... sExp File/directory name to check forπ * Returns ....... TRUE if sExp existsπ * Notes ......... Not picky, will even accept wild cardsπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION Exist( sExp: STRING ): BOOLEAN;πVAR s : SearchRec;πBEGINπ FINDFIRST( sExp, AnyFile, s );π Exist := (DOSError = 0);πEND;ππ 36 09-26-9309:11ALL MARTIN RICHARDSON Check if IS File SWAG9311 7 .l {*****************************************************************************π * Function ...... IsFile()π * Purpose ....... Checks for the existance of a fileπ * Parameters .... sFile File to check forπ * Returns ....... TRUE if sFile existsπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}π{ Checks for existance of a file }πFUNCTION IsFile( sFile: STRING ): BOOLEAN;πVAR s : SearchRec;πBEGINπ FINDFIRST( sFile, directory, s );π IsFile := (DOSError = 0) ANDπ (s.Attr AND Directory <> Directory) ANDπ (POS( '?', sFile ) = 0) ANDπ (POS( '*', sFile ) = 0);πEND;ππ 37 09-26-9309:30ALL MARTIN RICHARDSON Create a TEMP filename SWAG9311 10 .l {*****************************************************************************π * Function ...... TempFile()π * Purpose ....... To create a unique file name for use as a temporary workπ * fileπ * Parameters .... Path Location to create the fileπ * Returns ....... Name of temporary fileπ * Notes ......... Uses the functions Right, ItoS, Exist, and Emptyπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION TempFile( Path: STRING ): STRING;πVAR π DateStr : DateTime;π Trash : WORD;π Time : LONGINT;π FileName : STRING;πBEGINπ IF (NOT Empty( Path )) AND (Right( Path, 1 ) <> '\') THENπ Path := Path + '\';π REPEATπ WITH DateStr DO BEGINπ GETDATE( Year, Month, Day, Trash );π GETTIME( Hour, Min, Sec, Trash );π END;π PackTime( DateStr, Time );π FileName := Right( ItoS( Time, 0 ), 8 ) + '.$$$';π UNTIL NOT Exist( Path + FileName );π TempFile := Path + FileName;πEND;π 38 11-02-9306:33ALL SWAG SUPPORT TEAM Reading User/IDX Files SWAG9311 67 .l {π Here's the demo Program I promised. You'll have to add the missingπ Type definitions before you will be able to run this Program.π}ππProgram Demo_Read_User_Files;ππTypeππ (* NOTE: Missing Type definitions need to go here, before this *)π (* Program will compile. *)π (* *)π (* ie: uflags, suflags, acrq, mhireadr, mzscanr, fzscanr, *)π (* colors. *)π (* *)ππ (* USERS.IDX : Sorted names listing *)π UserIdxRec = Recordπ Name : String[36]; (* Name (Real or handle) *)π Number : Integer; (* User number *)π RealName : Boolean; (* User's Real name? *)π Deleted : Boolean; (* Deleted or not *)π Left : Integer; (* Record or -1 *)π Right : Integer; (* Record or -1 *)π end;ππ (* USERS.DAT : User Records *)π UserRec = Recordπ Name : String[36]; (* System name *)π RealName : String[36]; (* Real name *)π PW : String[20]; (* PassWord *)π Ph : String[12]; (* Phone # *)π BDay : String[8]; (* Birthdate *)π FirstOn : String[8]; (* First on date *)π LastOn : String[8]; (* Last on date *)π Street : String[30]; (* Street address *)π CityState : String[30]; (* City, State *)π ZipCode : String[10]; (* Zipcode *)ππ (* Type of computer *)π UsrDefStr : Array[1..3] of String[35];ππ (* Occupation *)ππ (* BBS reference *)π Note : String[35]; (* SysOp note *)π UserStartMenu : String[8]; (* Menu to start at *)π LockedFile : String[8]; (* Print lockout msg*)π Flags : set of uflags; (* Flags *)π SFlags : set of suflags; (* Status flags *)π AR : set of acrq; (* AR flags *)ππ (* Voting data *)π Vote : Array[1..25] of Byte;ππ Sex : Char; (* Gender *)π TTimeOn, (* Total time on *)π UK, (* UL k *)π DK : LongInt; (* DL k *)π TLToday, (* # Min left today *)π ForUsr, (* Forward mail to *)π FilePoints : Integer; (* # Of File points *)ππ UpLoads, DownLoads, (* # Of ULs/# of DLs*)π LoggedOn, (* # Times on *)π MsgPost, (* # Message posts *)π EmailSent, (* # Email sent *)π Feedback, (* # Feedback sent *)π Timebank, (* # Mins in bank *)π TimebankAdd, (* # Added today *)π DlKToday, (* # KBytes dl today*)π DlToday : Word; (* # Files dl today *)ππ Waiting, (* Mail waiting *)π LineLen, (* Line length *)π PageLen, (* Page length *)π OnToday, (* # Times on today *)π Illegal, (* # Illegal logons *)π Barf,π LastMBase, (* # Last msg base *)π LastFBase, (* # Last File base *)π SL, DSL : Byte; (* SL / DSL *)ππ (* Message last read date ptrs *)π MHiRead : mhireadr;π (* Which message bases to scan *)π MzScan : mzscanr;π (* Which File bases to scan *)π FzScan : fzscanr;ππ (* User colors *)π Cols : colors;ππ Garbage : Byte;ππ (* Amount of time Withdrawn today *)π TimebankWith : Word;π (* Last day PassWord changed *)π PassWordChanged : Word;π (* Default QWK archive Type *)π DefArcType : Byte;π (* Last conference they were in *)π LastConf : Char;π (* Date/time of last qwk packet *)π LastQwk : LongInt;π (* Add own messages to qwk packet? *)π GetOwnQwk : Boolean;π (* Scan File bases For qwk packets? *)π ScanFilesQwk : Boolean;π (* Get private mail in qwk packets? *)π PrivateQwk : Boolean;π (* Amount of credit a User has *)π Credit : LongInt;π (* Amount of debit a User has *)π Debit : LongInt;π (* Expiration date of this User *)π Expiration : LongInt;π (* Subscription level to expire to *)π ExpireTo : Char;π (* User's color scheme # *)π ColorScheme : Byte;π (* Echo Teleconf lines? *)π TeleConfEcho : Boolean;π (* Interrupt during typing? *)π TeleConfInt : Boolean;π end;πππ(***** Check For IO error, and take some sort of action? *)π(* *)πProcedure CheckForIOerror;πVarπ in_Error : Integer;πbeginπ in_Error := ioresult;π if (in_Error <> 0) thenπ beginπ Writeln(' I/O Error = ', in_Error);ππ (* Take some sort of action to correct error, or halt Program *)ππ endπend; (* CheckForIOerror. *)πππVarπ rc_TempUI : UserIdxRec;π rc_TempUR : UserRec;ππ fi_UsersIdx : File of UserIdxRec;π fi_UsersDat : File of UserRec;ππbeginπ (* Open USERS.IDX File. *)π assign(fi_UsersIdx, 'USERS.IDX');π {$I-}π reset(fi_UsersIdx);π {$I+}π CheckForIOerror;ππ (* Read first Record from File. *)π read(fi_UsersIdx, rc_TempUI);π CheckForIOerror;ππ (* Display data from the first Record. *)π With rc_TempUI doπ beginπ Writeln('Name = ', Name);π Writeln('Number = ', Number);π Writeln('Real Name = ', RealName);π Writeln('Deleted = ', Deleted);π Writeln('Left = ', Left);π Writeln('Right = ', Right)π end;ππ (* Read 10th Record from File. *)π seek(fi_UsersIdx, pred(10));π read(fi_UsersIdx, rc_TempUI);π CheckForIOerror;ππ (* Display data from the 10th Record. *)π With rc_TempUI doπ beginπ Writeln('Name = ', Name);π Writeln('Number = ', Number);π Writeln('Real Name = ', RealName);π Writeln('Deleted = ', Deleted);π Writeln('Left = ', Left);π Writeln('Right = ', Right)π end;ππ (* Close USERS.IDX File. *)π close(fi_UsersIdx);π CheckForIOerror;ππ (* Open USERS.DAT File. *)π assign(fi_UsersDat, 'USERS.DAT');π {$I-}π reset(fi_UsersDat);π {$I+}π CheckForIOerror;ππ (* Read first Record from File. *)π read(fi_UsersDat, rc_TempUR);π CheckForIOerror;ππ (* Display data from the first Record. *)π With rc_TempUR doπ beginπ Writeln('Name = ', Name);π Writeln('Real Name = ', RealName);π Writeln('Street = ', Street);π Writeln('CityState = ', CityState);π Writeln('ZipCode = ', ZipCode);π Writeln('Sex = ', Sex)π end;ππ (* Read 10th Record from File. *)π seek(fi_UsersDat, pred(10));π read(fi_UsersDat, rc_TempUR);π CheckForIOerror;ππ (* Display data from the 10th Record. *)π With rc_TempUR doπ beginπ Writeln('Name = ', Name);π Writeln('Real Name = ', RealName);π Writeln('Street = ', Street);π Writeln('CityState = ', CityState);π Writeln('ZipCode = ', ZipCode);π Writeln('Sex = ', Sex)π end;ππ (* Close USERS.DAT File. *)π close(fi_UsersDat);π CheckForIOerror;ππend.ππ 39 11-02-9305:54ALL TIMO SALMI Another File Hider SWAG9311 10 .l {πts@uwasa.fi (Timo Salmi)ππ Q: How can one hide (or unhide) a directory using a TP Program?ππ A: SetFAttr which first comes to mind cannot be used For this.πInstead interrupt Programming is required. Here is the code.πIncidentally, since MsDos 5.0 the attrib command can be used to hideπand unhide directories.π(* Hide a directory. Before using it would be prudent to checkπ that the directory exists, and that it is a directory.π With a contribution from Jan Nielsen jak@hdc.hha.dkπ Based on information from Duncan (1986), p. 410 *)π}πProcedure HIDE(dirname : String);πVarπ regs : Registers;πbeginπ FillChar(regs, SizeOf(regs), 0); { standard precaution }π dirname := dirname + #0; { requires ASCII Strings }π regs.ah := $43; { Function }π regs.al := $01; { subFunction }π regs.ds := Seg(dirname[1]); { point to the name }π regs.dx := Ofs(dirname[1]);π regs.cx := 2; { set bit 1 on } { to unhide set regs.cx := 0 }π Intr ($21, regs); { call the interrupt }π if regs.Flags and FCarry <> 0 then { were we successful }π Writeln('Failed to hide');πend;π
